{-# OPTIONS_GHC -fglasgow-exts #-}
module Main where

import WS.Runtime.Main 
import XI.Directory.GetXiObj
import XI.Directory.Types
import XI.Directory.Todo
import XI.Directory.Parser
import Codec.Binary.Base64.String
import Data.Maybe
import Data.Time.LocalTime
import Data.List
import Control.Concurrent
import Data.Traversable
import System.IO.UTF8 (readFile, writeFile)
import Prelude hiding (readFile, writeFile)

{-
    You should use file TestWSDL.par with following description of params:
    
#	
# if string starts with '#' it is ignored
#
Maybe proxy-file 
host:port
user:pwd
Maybe log-file
#
#
    
-}
check_par :: forall a. [a] -> [a]
check_par par 
    | length par < 4 	= error "TestWSDL.par is incorrect"
    | otherwise 		= par

wsp :: IO WsParams
wsp = do
    par <- liftM (check_par . filter ((/="#") . take 1) . lines ) $ readFile "TestWSDL.par"
    prxFile <- return $ read $ head par
    proxy <- wsProxy prxFile >>= newMVar
    log_var <- newMVar ()
    return WsParams {
            wspProxyMVar = proxy,
            wspLogMVar = log_var,
            wspServer = par!!1,
            wspAuthorization = Just $ "Basic " ++ encode (par!!2),
            wspProxy = prxFile,
            wspProtocolStr = "HTTPBasicAuth?style=document",
            wspLog = read $ par!!3
        }

get_res :: IO [XIObj]		
get_res = do
    wsp' <- wsp
    res <- liftM concat $ 
            zipWithM (setVar wsp') [getCC, getSA, getRA, getRD, getID, getCS, getIP] ["CC", "SA", "RA", "RD", "ID", "CS", "IP"] >>= 
            traverse takeMVar
    saveProxy wsp'
    return res
    where
        setVar wsp' f s = newEmptyMVar >>= (\res -> forkIO (f wsp' >>= (\x -> putMVar res x >> write''' (s ++ "Obj.res") x )) >> return res)
        write' file str = putTime writeFile >> appendFile file (str ++ "\n") >> putTime appendFile
            where 
                putTime f = getZonedTime >>= f file . (++"\n") . show
        -- write'' s f dl = write' s $ unlines $ map show $ nub $ concatMap maybeToList $ map f dl
        write''' s = write' s . unlines . map show . nub
        
getScenarioChains :: Configuration -> String -> [Chain]
getScenarioChains cfg name = scenario_chains . head . filter ((==name) . fromMaybe "" . scenario_name) $ fst cfg

main :: IO ()
main = do
    res <- get_res
    case scenarios res of 
        Left err -> putStr err
        Right scs -> writeFile "script.res" $ unlines $ scriptDir scs
